home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / COMPNENT / DTOOLS3 / DTOOLS3.ZIP / DEMODRAW.PAS < prev    next >
Pascal/Delphi Source File  |  1995-11-06  |  7KB  |  262 lines
  1. unit Demodraw;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Toggler, StdCtrls, Custbtn, ExtCtrls, Balloon;
  8.  
  9. type
  10.   TOwnerDrawControls = class(TForm)
  11.     btnDraw: TODButton;
  12.     GroupBox1: TGroupBox;
  13.     rbRoundRect: TODRadioButton;
  14.     rbRect: TODRadioButton;
  15.     GroupBox2: TGroupBox;
  16.     rbBalloon: TODRadioButton;
  17.     rbCustom: TODRadioButton;
  18.     rbDefault: TODRadioButton;
  19.     GroupBox3: TGroupBox;
  20.     cycHintColor: TODCycler;
  21.     GroupBox4: TGroupBox;
  22.     chkEnableHints: TODCheckBox;
  23.     procedure rbShapeClick(Sender: TObject);
  24.     procedure rbTypeClick(Sender: TObject);
  25.     procedure chkEnableHintsClick(Sender: TObject);
  26.     procedure cycHintColorClick(Sender: TObject);
  27.     procedure rbShapePaint(Sender: TObject);
  28.     procedure rbTypePaint(Sender: TObject);
  29.     procedure chkEnableHintsPaint(Sender: TObject);
  30.     procedure cycHintColorPaint(Sender: TObject);
  31.     procedure btnDrawPaint(Sender: TObject);
  32.   private
  33.     procedure PaintBalloon(cvs: TCanvas; col: TColor;
  34.       Shape: TBalloonShape);
  35.     procedure InitBackground(cvs: TCanvas; r: TRect; foc: Boolean);
  36.     procedure RefreshEm;
  37.   public
  38.     { Public declarations }
  39.   end;
  40.  
  41. var
  42.   OwnerDrawControls: TOwnerDrawControls;
  43.  
  44. implementation
  45.  
  46. uses Demomain;
  47.  
  48. {$R *.DFM}
  49.  
  50. procedure TOwnerDrawControls.RefreshEm;
  51. begin
  52.   rbRoundRect.Refresh;
  53.   rbRect.Refresh;
  54.   rbBalloon.Refresh;
  55.   rbCustom.Refresh;
  56.   rbDefault.Refresh;
  57.   cycHintColor.Refresh;
  58.   chkEnableHints.Refresh;
  59. end;
  60.  
  61. procedure TOwnerDrawControls.InitBackground(cvs: TCanvas; r: TRect; foc: Boolean);
  62. begin
  63.   cvs.FillRect(r);
  64.   if foc then begin
  65.     InflateRect(r, -1, -1);
  66.     cvs.DrawFocusRect(r);
  67.   end;
  68. end;
  69.  
  70. procedure TOwnerDrawControls.PaintBalloon(cvs: TCanvas; col: TColor;
  71.   Shape: TBalloonShape);
  72. var
  73.   r: TRect;
  74.   r1, r2, r3: HRgn;
  75.   pts: array[0..2] of TPoint;
  76.   balBottom: Integer;
  77. begin
  78.   r := Rect(4, 4, 48, 48);
  79.   cvs.Brush.Color := col;
  80.   balBottom := (r.bottom * 2) div 3;
  81.   if Shape = bsRoundRect then
  82.     r1 := CreateRoundRectRgn(r.left, r.top, r.right, balBottom + 1, 10, 10)
  83.   else
  84.     r1 := CreateRectRgn(r.left, r.top, r.right, balBottom + 1);
  85.   pts[0] := Point(r.left, r.bottom);
  86.   pts[1] := Point(r.left + 5, balBottom);
  87.   pts[2] := Point(r.left + 10, balBottom);
  88.   r2 := CreatePolygonRgn(pts, 3, ALTERNATE);
  89.   r3 := CreateRectRgn(0, 0, 1, 1);
  90.   CombineRgn(r3, r2, r1, RGN_OR);
  91.   PaintRgn(cvs.Handle, r3);
  92.   cvs.Brush.Color := clWindowFrame;
  93.   FrameRgn(cvs.Handle, r3, cvs.Brush.Handle, 1, 1);
  94.   DeleteObject(r1);
  95.   DeleteObject(r2);
  96.   DeleteObject(r3);
  97. end;
  98.  
  99. procedure TOwnerDrawControls.rbShapeClick(Sender: TObject);
  100. begin
  101.   if rbRect.Checked then
  102.     FrontPanel.BalloonHint.Shape := bsRectangle
  103.   else
  104.     FrontPanel.BalloonHint.Shape := bsRoundRect;
  105.   RefreshEm;
  106. end;
  107.  
  108. procedure TOwnerDrawControls.rbTypeClick(Sender: TObject);
  109. begin
  110.   if rbBalloon.Checked then
  111.     FrontPanel.BalloonHint.Active := True
  112.   else if rbCustom.Checked then
  113.     FrontPanel.CustomHint.Active := True
  114.   else begin
  115.     FrontPanel.BalloonHint.Active := False;
  116.     FrontPanel.CustomHint.Active := False;
  117.   end;
  118. end;
  119.  
  120. procedure TOwnerDrawControls.chkEnableHintsClick(Sender: TObject);
  121. begin
  122.   Application.ShowHint := chkEnableHints.Checked;
  123. end;
  124.  
  125. procedure TOwnerDrawControls.cycHintColorClick(Sender: TObject);
  126. var
  127.   col: TColor;
  128. begin
  129.   case cycHintColor.Value of
  130.     0:  col := clWhite;
  131.     1:  col := $0080FFFF;
  132.     2:  col := $00FFFF80;
  133.   end;
  134.   Application.HintColor := col;
  135.   RefreshEm;
  136. end;
  137.  
  138. procedure TOwnerDrawControls.rbShapePaint(Sender: TObject);
  139. var
  140.   rb: TODRadioButton;
  141.   col: TColor;
  142. begin
  143.   rb := TODRadioButton(Sender);
  144.   rb.Canvas.Brush.Style := bsSolid;
  145.   InitBackground(rb.Canvas, rb.ClientRect, rb.Focused);
  146.   if rb.Checked then
  147.     col := Application.HintColor
  148.   else
  149.     col := clBtnFace;
  150.   if Sender = rbRect then
  151.     PaintBalloon(rb.Canvas, col, bsRectangle)
  152.   else
  153.     PaintBalloon(rb.Canvas, col, bsRoundRect);
  154. end;
  155.  
  156. procedure TOwnerDrawControls.rbTypePaint(Sender: TObject);
  157. var
  158.   rb: TODRadioButton;
  159.   col: TColor;
  160.   r: TRect;
  161. begin
  162.   rb := TODRadioButton(Sender);
  163.   rb.Canvas.Brush.Style := bsSolid;
  164.   InitBackground(rb.Canvas, rb.ClientRect, rb.Focused);
  165.   if rb.Checked then
  166.     col := Application.HintColor
  167.   else
  168.     col := clBtnFace;
  169.   if Sender = rbBalloon then begin
  170.     PaintBalloon(rb.Canvas, col, FrontPanel.BalloonHint.Shape);
  171.     r := Rect(52, 0, 124, 52);
  172.     rb.Canvas.Brush.Style := bsClear;
  173.     DrawText(rb.Canvas.Handle, 'Balloon', -1, r, DT_VCENTER or DT_SINGLELINE);
  174.   end
  175.   else if Sender = rbCustom then begin
  176.     rb.Canvas.Brush.Color := col;
  177.     rb.Canvas.Rectangle(4, 4, 48, 48);
  178.     r := Rect(52, 0, 124, 52);
  179.     rb.Canvas.Brush.Style := bsClear;
  180.     DrawText(rb.Canvas.Handle, 'Custom', -1, r, DT_VCENTER or DT_SINGLELINE);
  181.   end
  182.   else begin {rbDefault}
  183.     rb.Canvas.Brush.Color := col;
  184.     rb.Canvas.Rectangle(6, 6, 110, 24);
  185.     r := Rect(120, 0, 256, 30);
  186.     rb.Canvas.Brush.Style := bsClear;
  187.     DrawText(rb.Canvas.Handle, 'Default', -1, r, DT_VCENTER or DT_SINGLELINE);
  188.   end;
  189. end;
  190.  
  191. procedure TOwnerDrawControls.chkEnableHintsPaint(Sender: TObject);
  192. var
  193.   chk: TODCheckBox;
  194. begin
  195.   chk := TODCheckBox(Sender);
  196.   InitBackground(chk.Canvas, chk.ClientRect, chk.Focused);
  197.   chk.Canvas.Brush.Style := bsSolid;
  198.   PaintBalloon(chk.Canvas, Application.HintColor, FrontPanel.BalloonHint.Shape);
  199.   if not chk.Checked then begin
  200.     chk.Canvas.Brush.Style := bsClear;
  201.     chk.Canvas.Pen.Color := clRed;
  202.     chk.Canvas.Pen.Width := 4;
  203.     chk.Canvas.MoveTo(8, 8);
  204.     chk.Canvas.LineTo(44, 44);
  205.     chk.Canvas.MoveTo(8, 44);
  206.     chk.Canvas.LineTo(44, 8);
  207.   end;
  208. end;
  209. procedure TOwnerDrawControls.cycHintColorPaint(Sender: TObject);
  210. var
  211.   cyc: TODCycler;
  212.   col: TColor;
  213. begin
  214.   cyc := TODCycler(Sender);
  215.   InitBackground(cyc.Canvas, cyc.ClientRect, cyc.Focused);
  216.   case cyc.Value of
  217.     0:  col := clWhite;
  218.     1:  col := $0080FFFF;
  219.     2:  col := $00FFFF80;
  220.   end;
  221.   PaintBalloon(cyc.Canvas, col, FrontPanel.BalloonHint.Shape);
  222. end;
  223.  
  224. procedure TOwnerDrawControls.btnDrawPaint(Sender: TObject);
  225. var
  226.   btn: TODButton;
  227.   r: TRect;
  228.   x, y: Integer;
  229. begin
  230.   btn := TODButton(Sender);
  231.   btn.Canvas.Pen.Width := 1;
  232.   btn.Canvas.Brush.Color := clBtnFace;
  233.   btn.Canvas.Brush.Style := bsSolid;
  234.   btn.Canvas.FillRect(btn.ClientRect);
  235.   if btn.IsDown then begin
  236.     btn.Canvas.Brush.Color := clBlack;
  237.     btn.Canvas.Font.Color := clWhite;
  238.   end
  239.   else begin
  240.     btn.Canvas.Brush.Color := clWhite;
  241.     btn.Canvas.Font.Color := clBlack;
  242.   end;
  243.   r := btn.ClientRect;
  244.   InflateRect(r, -2, -2);
  245.   if btn.Default then
  246.     btn.Canvas.Pen.Width := 3;
  247.   btn.Canvas.RoundRect(r.left, r.top, r.right, r.bottom, 10, 10);
  248.  
  249.   x := (btn.Width div 2) - (btn.Canvas.TextWidth('OK') div 2);
  250.   y := (btn.Height div 2) - (btn.Canvas.TextHeight('OK') div 2);
  251.   btn.Canvas.TextOut(x, y, 'OK');
  252.   if btn.Focused then begin
  253.     r.left := x;
  254.     r.top := y;
  255.     r.right := x + btn.Canvas.TextWidth('OK');
  256.     r.bottom := y + btn.Canvas.TextHeight('OK');
  257.     btn.Canvas.DrawFocusRect(r);
  258.   end;
  259. end;
  260.  
  261. end.
  262.